﻿unit MVC.Tool;

interface

uses
  System.SysUtils, System.Classes, IdURI, IdGlobal, DBXJSON,
  {$IFDEF MSWINDOWS} winapi.windows, Vcl.Imaging.jpeg, Vcl.Graphics, {$ENDIF}
  system.json, IdCoderMIME, EncdDecd, System.RegularExpressions, System.Rtti,
  Data.DB, FireDAC.Comp.Client;

type
  ITool = interface
    ['{178CA435-81DE-4D50-AC60-6FA8E4C56A9A}']
    function FirstToUpper(Value: string): string;
    function fmtKey(k: string; s: string): string;
    procedure JSONToRecord(ATypeInfo, Instance: Pointer; json: TJSONObject);
    function RecordToJSON(ATypeInfo, Instance: Pointer): string;
    function URLDecode(Asrc: string; AByteEncoding: IIdtextEncoding): string;
    function URLEncode(Asrc: string; AByteEncoding: IIdTextEncoding): string;
    function UnicodeDecode(Asrc: string): string;
    function UnicodeEncode(Asrc: string): string;
    function Base64Decode(S: string): string;
    function Base64Encode(S: string): string;
    {$IFDEF MSWINDOWS}
    function BitmapToString(img: TBitmap): string;
    function StringToBitmap(imgStr: string): TBitmap;
    function NumToImage(num: string): string;
    function getVCode(out num: string): string; //返回图片的base64编码
    {$ENDIF}
    function StringFormat(Asrc: string): string;
    function Unicode(Asrc: string): string;
    function StringFormatF(Asrc: string): string;
    function PathFmt(path: string): string;
    function UrlFmt(url: string): string;
    function GetGUID: string;
    function ToDateTime(date: string): TDateTime;
    function DSToJObject(ds: TFDQuery): string;
    function DSToJArray(ds: TFDQuery): string;
  end;

  TTool = class(TInterfacedObject, ITool)
  private
  public
    function FirstToUpper(Value: string): string;
    function fmtKey(k: string; s: string): string;
    procedure JSONToRecord(ATypeInfo, Instance: Pointer; json: TJSONObject);
    function RecordToJSON(ATypeInfo, Instance: Pointer): string;
    function URLDecode(Asrc: string; AByteEncoding: IIdtextEncoding): string;
    function URLEncode(Asrc: string; AByteEncoding: IIdTextEncoding): string;
    function UnicodeDecode(Asrc: string): string;
    function UnicodeEncode(Asrc: string): string;
    function Unicode(Asrc: string): string;
    function Base64Decode(S: string): string;
    function Base64Encode(S: string): string;
    {$IFDEF MSWINDOWS}
    function BitmapToString(img: TBitmap): string;
    function StringToBitmap(imgStr: string): TBitmap;
    function NumToImage(num: string): string;
    function getVCode(out num: string): string;
    {$ENDIF}
    function StringFormat(Asrc: string): string;
    function StringFormatF(Asrc: string): string;
    function PathFmt(path: string): string;
    function UrlFmt(url: string): string;
    function GetGUID: string;
    function ToDateTime(date: string): TDateTime;
    function DSToJObject(ds: TFDQuery): string;
    function DSToJArray(ds: TFDQuery): string;
  end;

function IITool: ITool;

implementation

uses
  mvc.Config;

function IITool: ITool;
begin
  Result := TTool.Create as ITool;
end;

function TTool.FirstToUpper(Value: string): string;
var
  s: string;
begin
  if Trim(Value) <> '' then
  begin
    s := Value[1];
    s := s.ToUpper + Copy(Value, 2, Length(Value)).ToLower;
    Result := s;
  end;
end;

function TTool.fmtKey(k: string; s: string): string;
var
  str: TStringList;
  i: integer;
  v, ret: string;
begin
  str := TStringList.Create;
  str.Delimiter := k.Chars[0];
  str.DelimitedText := s;
  for i := 0 to str.Count - 1 do
  begin
    v := str[i];
    if (v <> '') and (v <> '_') then
    begin
      if ret = '' then
        ret := v
      else
        ret := ret + FirstToUpper(v);
    end;
  end;
  str.Free;
  Result := ret;
end;

function TTool.RecordToJSON(ATypeInfo, Instance: Pointer): string;
var
  _RTTIContext: TRttiContext;
  _type: TRttiType;
  _proper: TRttiField;
  _method: TRttiMethod;
  json: string;
  key, value, stype: string;
  _value: TValue;
begin
  _type := _RTTIContext.GetType(ATypeInfo);
  json := '';

  for _proper in _type.AsRecord.GetFields do
  begin
    key := '"' + (_proper.Name) + '"';
    stype := _proper.FieldType.ToString;
    if Pos('Array', stype) > 0 then
    begin
      Continue;
    end;
    if _proper.FieldType.IsRecord then
    begin
      _method := _proper.FieldType.GetMethod('toJSON');
      value := _method.Invoke(_proper.GetValue(Instance), []).AsString;
    end
    else
    begin
      _value := _proper.GetValue(Instance);
      value := _value.AsVariant;
      value := '"' + trim(value) + '"';
    end;
    json := json + key + ':' + value + ',';
  end;
  json := json.Substring(0, json.Length - 1);
  if json <> '' then
    json := '{' + json + '}'
  else
    json := '{}';
  Result := json;
end;
 {$IFDEF MSWINDOWS}

function TTool.getVCode(out num: string): string;
var
  code: string;
  i: integer;
const
  str = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
begin
  for i := 0 to 3 do
  begin
    code := code + Copy(str, Random(Length(str)), 1);
  end;
  num := code;
  Result := NumToImage(code);
end;
{$ENDIF}

procedure TTool.JSONToRecord(ATypeInfo, Instance: Pointer; json: TJSONObject);
var
  _RTTIContext: TRttiContext;
  _type: TRttiType;
  _proper: TRttiField;
  key, stype: string;
  jsonitem: TJSONPair;
begin
  _type := _RTTIContext.GetType(ATypeInfo);
  for _proper in _type.AsRecord.GetFields do
  begin
    key := _proper.Name;
    stype := _proper.FieldType.ToString;
    jsonitem := json.Get(key);
    if jsonitem <> nil then
    begin
      _proper.SetValue(Instance, jsonitem.JsonValue.Value);
    end;
  end;
end;
 {$IFDEF MSWINDOWS}

function TTool.NumToImage(num: string): string;
var
  bmp_t: TBitmap;
  i: integer;
  s: string;
begin
  bmp_t := TBitmap.Create;
  try
    bmp_t.SetSize(90, 35);
    bmp_t.Transparent := True;
    for i := 1 to length(num) do
    begin
      s := num[i];
      bmp_t.Canvas.Rectangle(0, 0, 90, 35);
      bmp_t.Canvas.Pen.Style := psClear;
      bmp_t.Canvas.Brush.Style := bsClear;
      bmp_t.Canvas.Font.Color := Random(256) and $C0; // 新建个水印字体颜色
//      bmp_t.Canvas.Font.Size := Random(6) + 11;
      bmp_t.Canvas.Font.Height := Random(5) + 24; //高分屏显示不全
      bmp_t.Canvas.Font.Style := [fsBold];
      bmp_t.Canvas.Font.Name := 'Verdana';
      bmp_t.Canvas.TextOut(i * 15, 5, s); // 加入文字
    end;
    s := IITool.BitmapToString(bmp_t);
    Result := s;
  finally
    FreeAndNil(bmp_t);
  end;
end;
{$ENDIF}

function TTool.Unicode(Asrc: string): string;
var
  w: Word;
  hz: WideString;
  i: Integer;
  s: string;
begin

  hz := Asrc;

  for i := 1 to Length(hz) do
  begin
    w := Ord(hz[i]);
    s := s + '\u' + IntToHex(w, 4);
  end;
  Result := LowerCase(s);
end;

function TTool.UnicodeDecode(Asrc: string): string;
var
  index: Integer;
  temp, top, last: string;
begin
  index := 1;
  while index >= 0 do
  begin
    index := Pos('\u', Asrc) - 1;
    if index < 0 then         //非 unicode编码不转换 ,自动过滤
    begin
      last := Asrc;
      Result := Result + last;
      Exit;
    end;
    top := Copy(Asrc, 1, index); // 取出 编码字符前的 非 unic 编码的字符，如数字
    temp := temp + Copy(Asrc, index + 1, 6); // 取出编码，包括 \u,如\u4e3f
    Delete(temp, 1, 2);
    Delete(Asrc, 1, index + 6);
  end;
  Result := Result + top + WideChar(StrToInt('$' + temp));
end;
//判断字符是否是汉字

function IsHZ(ch: WideChar): boolean;
var
  i: integer;
begin
  i := ord(ch);
  if (i < 19968) or (i > 40869) then
    result := false
  else
    result := true;
end;

function TTool.UnicodeEncode(Asrc: string): string;
var
  w: Word;
  hz: WideString;
  i: Integer;
  s: string;
begin

  hz := StringFormat(Asrc);

  for i := 1 to Length(hz) do
  begin
    if IsHZ(hz[i]) then
    begin
      w := Ord(hz[i]);
      s := s + '\u' + IntToHex(w, 4);
    end
    else
      s := s + hz[i];
  end;
  Result := s;
end;

function TTool.URLDecode(Asrc: string; AByteEncoding: IIdtextEncoding): string;
begin
  if AByteEncoding <> nil then
    Result := TIdURI.URLDecode(Asrc, AByteEncoding)
  else
    Result := TIdURI.URLDecode(Asrc);
end;

function TTool.URLEncode(Asrc: string; AByteEncoding: IIdTextEncoding): string;
begin
  if AByteEncoding <> nil then
    Result := TIdURI.URLEncode(Asrc, AByteEncoding)
  else
    Result := TIdURI.URLEncode(Asrc);
end;

function TTool.UrlFmt(url: string): string;
var
  ret: string;
begin
  ret := url.Replace('\\', '/').Replace('//', '/').Replace('\', '/');
  Result := ret;
end;

function TTool.Base64Encode(S: string): string;
var
  base64: TIdEncoderMIME;
 // tmpBytes: TBytes;
begin
  base64 := TIdEncoderMIME.Create(nil);
  try
    base64.FillChar := '=';
    Result := base64.EncodeString(S);
   // tmpBytes := TEncoding.UTF8.GetBytes(S);
   // Result := base64.EncodeBytes(TIdBytes(tmpBytes));
  finally
    base64.Free;
  end;
end;
///将base64字符串转化为Bitmap位图

function TTool.StringFormat(Asrc: string): string;
var
  s: string;
begin
  s := Asrc;
  s := s.Replace(#7, '\a').Replace(#8, '\b').Replace(#12, '\f');
  s := s.Replace(#9, '\t').Replace(#11, '\v').Replace(#92, '\\');
  s := s.Replace(#39, '''').Replace(#34, '\"');
  s := s.Replace(#13, '\\r').Replace(#10, '\\n');
  Result := s;
end;

function TTool.StringFormatF(Asrc: string): string;
var
  s: string;
begin
  s := Asrc;
  s := s.Replace(#92, '\\');
  Result := s;
end;
 {$IFDEF MSWINDOWS}

function TTool.StringToBitmap(imgStr: string): TBitmap;
var
  ss: TStringStream;
  ms: TMemoryStream;
  bitmap: TBitmap;
begin
  ss := TStringStream.Create(imgStr);
  ms := TMemoryStream.Create;
  DecodeStream(ss, ms); //将base64字符流还原为内存流
  ms.Position := 0;
  bitmap := TBitmap.Create;
  bitmap.LoadFromStream(ms);
  ss.Free;
  ms.Free;
  result := bitmap;
end;

function TTool.ToDateTime(date: string): TDateTime;
var
  v: string;
begin
  v := date;
 // if (v.Length = 10) then
 //   v := v + ' 00:00:00';
  try
    Result := StrToDateTime(v);
  except
    v := v.Replace('-', '/');
    Result := StrToDateTime(v);
  end;
end;

{$ENDIF}
///将Bitmap位图转化为base64字符串
 {$IFDEF MSWINDOWS}
{$ENDIF}
function TTool.BitmapToString(img: TBitmap): string;
var
  ms: TMemoryStream;
  ss: TStringStream;
  s: string;
begin
  ms := TMemoryStream.Create;
  img.SaveToStream(ms);
  ss := TStringStream.Create('');
  ms.Position := 0;
  EncodeStream(ms, ss); //将内存流编码为base64字符流
  s := ss.DataString;
  ms.Free;
  ss.Free;
  result := s;
end;

function checkType(dbtype: TFieldType): Boolean;
begin
  if dbtype in [ftString, ftWideString, ftUnknown, ftWideMemo, ftMemo, ftDate, ftDateTime, ftTime, ftFmtMemo, ftTimeStamp, ftTimeStampOffset] then
  begin
    Result := true;
  end
  else
  begin
    Result := false;
  end;
end;

function TTool.DSToJArray(ds: TFDQuery): string;
var
  k: Integer;
  ret: string;
  ftype: TFieldType;
  json, item, key, value: string;
  aStream: TStringStream;
begin
  ret := '';
  with ds do
  begin
    if IsEmpty or (not Active) then
    begin
      Result := '[]';
      exit;
    end;
    json := '';
    First;

    while not Eof do
    begin
      item := '';
      for k := 0 to Fields.Count - 1 do
      begin
        key := Fields[k].DisplayLabel;

        ftype := Fields[k].DataType;
        if Config.JsonFmt <> '' then
          key := IITool.fmtKey(Config.JsonFmt, key);
        if Config.JsonToLower then
          key := key.ToLower;

        if checkType(ftype) then
        begin
          value := Fields[k].AsString;
          value := '"' + UnicodeEncode(value) + '"'
        end
        else if ftype = ftBoolean then
        begin
          value := Fields[k].AsString;
          value := value.ToLower;
          if (value = '') or (value = '0') then
            value := 'false'
          else if value = '1' then
            value := 'true';
        end
        else if ftype = ftBlob then
        begin
          aStream := TStringStream.Create('', TEncoding.UTF8, True);
          try
            TBlobField(Fields[k]).SaveToStream(aStream);
            aStream.position := 0;
            value := '"' + aStream.DataString + '"';
          finally
            aStream.Free;
          end;
        end
        else
          value := Fields[k].AsString;
        if value = '' then
          value := '0';
        item := item + '"' + key + '"' + ':' + value + ',';
      end;
      item := copy(item, 1, item.Length - 1);
      item := '{' + item + '},';
      json := json + item;
      Next;
    end;
    if json.Length > 1 then
      json := copy(json, 1, json.Length - 1);
    json := '[' + json + ']';
    Result := json;
  end;
end;

function TTool.DSToJObject(ds: TFDQuery): string;
var
  k: Integer;
  ftype: TFieldType;
  json, item, key, value: string;
begin
  json := '';
  with ds do
  begin

    if IsEmpty or (not Active) then
    begin
      Result := '{}';
      exit;
    end;

    if not IsEmpty then
    begin
      item := '{';
      for k := 0 to Fields.Count - 1 do
      begin
        key := Fields[k].DisplayLabel;
        value := Fields[k].AsString;
        ftype := Fields[k].DataType;
        if Config.JsonFmt <> '' then
          key := fmtKey(Config.JsonFmt, key);
        if Config.JsonToLower then
          key := key.ToLower;

        if checkType(ftype) then
        begin
          value := Fields[k].AsString;
          value := '"' + UnicodeEncode(value) + '"'

        end
        else if ftype = ftBoolean then
        begin
          value := value.ToLower;
          if (value = '') or (value = '0') then
            value := 'false'
          else if value = '1' then
            value := 'true';
        end;

        if value = '' then
          value := '0';
        item := item + '"' + key + '"' + ':' + value + ',';
      end;
      item := copy(item, 1, item.Length - 1);
      item := item + '},';
      json := json + item;
      Next;
    end;
    if json.Length > 1 then
      json := copy(json, 1, json.Length - 1);
    Result := json;
  end;
end;

function TTool.GetGUID: string;
var
  LTep: TGUID;
  sGUID: string;
begin
  CreateGUID(LTep);
  sGUID := GUIDToString(LTep);
  sGUID := StringReplace(sGUID, '-', '', [rfReplaceAll]);
  sGUID := Copy(sGUID, 2, Length(sGUID) - 2);
  result := sGUID;
end;

function TTool.PathFmt(path: string): string;
var
  ret: string;
begin
  {$IFDEF MSWINDOWS}
  ret := path.Replace('\\', '\').Replace('//', '\').Replace('/', '\');
  {$ELSE}
  ret := path.Replace('\\', '/').Replace('//', '/').Replace('\', '/');
  {$ENDIF}
  Result := ret;
end;

function TTool.Base64Decode(S: string): string;
var
  base64: TIdDeCoderMIME;
 // tmpBytes: TBytes;
begin
  Result := S;
  base64 := TIdDecoderMIME.Create(nil);
  try
    base64.FillChar := '=';
   // tmpBytes := TBytes(base64.DecodeBytes(S));
    //Result := TEncoding.UTF8.GetString(tmpBytes);
    Result := base64.DecodeString(S);
  finally
    base64.Free;
  end;
end;

end.

